home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / MCQUAY1 / TVLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-29  |  39KB  |  1,151 lines

  1.   {==================================================================
  2.    TVLIST
  3.    version 6  6/9/91
  4.    This unit implements a set of TCollection types and TDialog types
  5.    that facilitates the use of Lists and Listboxes.  Two abstract
  6.    classes are defined, TLIST and TSORTEDLIST that provide for expanded
  7.    TCollection functions. These Classes allow you to create instances
  8.    of TCollections with members of ANY data type and still use them
  9.    with a Listbox.  These are ABSTRACT classes, and virtual methods
  10.    must be defined for each of your list types.  Both sequential and
  11.    sorted lists are supported. Two classes TBOXER and TSORTEDBOXER
  12.    are defined that provide TListBox functionality.  Finally, two
  13.    classes TLISTDIALOG and TSORTEDLISTDIALOG provides an advanced
  14.    Dialog for use of listboxes.  This class can enable adding to the
  15.    lists, delete list items, editing list items, and search and
  16.    selection from the list.  All or none of these capabilities can
  17.    be selected. Also provided is a class LISTBOXINPUTLINE which can
  18.    be inserted into other Dialog boxes.  When selected LISTBOXINPUTLINE
  19.    will execute a TLISTDIALOG .
  20.  
  21.    This unit uses the the Compiler Definition of RegisterTVLIST to cause
  22.    the Unit to register Plist and PSortedList in its initialization code.
  23.    This must be commented out if you want to register by hand.
  24.  
  25.    Refer to TVLIST.DOC for documentation.  Refer to LISTDEMO.PAS and
  26.    LISTEXMP.PAS for examples of use.
  27.  
  28.    Bug Fixes:
  29.      Changed how List size changes are handled by ListBox.
  30.      Changed how SearchString is allocated and utilized.
  31.  
  32.    Copyright 1991 McQuay Technologies
  33.      2329 E. Cortez Phoenix AZ 85028
  34.      100 Sycamore Richmond TX
  35.      Prodigy ID WPTD01E Compuserve 72307,320
  36.      Released into the Public Domain, Give Credit were Credit Is Due
  37.    ==================================================================}
  38.  {$A-,B-,D+,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
  39.  unit TVLIST;
  40.    interface
  41.    uses Objects, App, Drivers, Views, Dialogs, msgBox;
  42.  
  43.    {$DEFINE REGISTERTVLIST  This Causes TVLIST to be registered in
  44.     initialization code comment this out if you want to register by hand.}
  45.  
  46.   {================================================================
  47.    TLISTREC
  48.     HERE IT IS, talked about but never actually defined in any public
  49.     code.
  50.    ================================================================}
  51.   type
  52.     TListRec = record
  53.       Item:pointer;
  54.       Index:integer;
  55.       end;
  56.   {==================================================================
  57.    TList  abstract Class
  58.    ==================================================================}
  59.    const
  60.      EndOfCollection = -1;    { Defines that Item was not found or
  61.                                 and Item Was not selected by TLISTDIALOG }
  62.  
  63.   type
  64.     PList = ^TList;
  65.     TList = object(TCollection)
  66.       function CreateItem(Corner:Tpoint):pointer; virtual;
  67.       procedure editItem(Corner:Tpoint;Item:pointer); virtual;
  68.       function GetItemText(item:pointer;MaxLen:word):string; virtual;
  69.       function AtAddNewItem(Corner:Tpoint;Index:integer):pointer;
  70.       function MaxTextLength:word;
  71.       end;
  72.   {==================================================================
  73.    TSortedList  abstract Class
  74.    ==================================================================}
  75.   type
  76.     PSortedList = ^TSortedList;
  77.     TSortedList = object(TSortedCollection)
  78.       function CreateItem(Corner:Tpoint):pointer; virtual;
  79.       procedure editItem(Corner:TPoint;Item:pointer); virtual;
  80.       function GetItemText(item:pointer;MaxLen:word):string; virtual;
  81.       function AtAddNewItem(Corner:TPoint):pointer;
  82.       function MaxTextLength:word;
  83.       end;
  84.   {==================================================================
  85.    TListBoxer  Class
  86.    ==================================================================}
  87.    type
  88.    PListBoxer = ^TListBoxer;
  89.    TListBoxer = object(TListBox)
  90.      function GetText(Item:Integer; MaxLen:integer):string; virtual;
  91.      procedure HandleEvent(var Event:TEvent); virtual;
  92.      end;
  93.   {==================================================================
  94.    TSortedListBoxer  Class
  95.    ==================================================================}
  96.    type
  97.    PSOrtedListBoxer = ^TSortedListBoxer;
  98.    TSortedListBoxer = object(TListBoxer)
  99.      function GetText(Item:Integer; MaxLen:integer):string; virtual;
  100.      end;
  101.   {==================================================================
  102.    TList an TListDialog Support Constants and Types
  103.    ==================================================================}
  104.    const
  105.  
  106.    { Behavior Constants }
  107.      sfAdd    = $1;
  108.      sfDelete = $2;
  109.      sfEdit   = $4;
  110.      sfSearch = $8;
  111.      sfPromptDelete = $10;
  112.      SfPromptExit = $20;
  113.      sfFullEdit = sfAdd + sfDelete + sfEdit;
  114.      sfDoall  = $FF;
  115.  
  116.  
  117.   {==================================================================
  118.    TListDialog  Class
  119.    ==================================================================}
  120.   Type
  121.    PListDialog = ^TListDialog;
  122.    TListDialog = object(TDialog)
  123.      AB : byte;
  124.      TLR:TListRec;
  125.      Max:byte;
  126.      List:pointer;
  127.      LB:PlistBox;
  128.      X,Y:word;
  129.      SearchString:^String;
  130.      constructor init(var Bounds:Trect; ATitle:TTitleStr;Behavior:byte;
  131.                       TheList : PList; BoxHeader:TTitleStr);
  132.      procedure   BASICinit(var Bounds:Trect; ATitle:TTitleStr;Behavior:byte;
  133.                            MaxStringLen:byte); virtual;
  134.      destructor done; virtual;
  135.      function  DataSize: word; virtual;
  136.      procedure GetData(var rec); virtual;
  137.      procedure SetData(var rec); virtual;
  138.      procedure HandleEvent(var Event:TEvent); virtual;
  139.      end;
  140.  
  141.   {==================================================================
  142.    TSortedListDialog  Class
  143.    ==================================================================}
  144.    PSortedListDialog = ^TSortedListDialog;
  145.    TSortedListDialog = object(TListDialog)
  146.      constructor init(var Bounds:Trect; ATitle:TTitleStr;Behavior:byte;
  147.                       TheList : PSortedList; BoxHeader:TTitleStr);
  148.      procedure HandleEvent(var Event:TEvent); virtual;
  149.      end;
  150.   {==================================================================
  151.    TListDialogInputField  Class
  152.    ==================================================================}
  153.   type
  154.   PListDialogInputField= ^TListDialogInputField;
  155.   TListDialogInputField= object(TInputLine)
  156.     TD:pointer;  { Pointer to Dialog }
  157.     TL:pointer;  { Pointer to List   }
  158.     max:byte;
  159.     Index:word;
  160.     Sorted:boolean;
  161.     constructor init (Field:TPoint;ListLocation:Tpoint;ListHeight:word;
  162.                       Title:String;Behavior:byte;AList:Pointer;
  163.                       BoxHeader:string;SortedList:boolean);
  164.     destructor done; virtual;
  165.     function  DataSize:word; virtual;
  166.     procedure GetData(Var Rec); virtual;
  167.     procedure SetData(Var Rec); virtual;
  168.     procedure HandleEvent(var Event:TEvent); virtual;
  169.     end;
  170.   {==================================================================
  171.    TVList Resource Registration
  172.    ==================================================================}
  173.    procedure RegisterTVList;
  174.   {==================================================================
  175.    Utilities
  176.    ==================================================================}
  177.    procedure MakeTrect(Corner:Tpoint;Xsize,YSize:integer;var Bounds:Trect);
  178.    Procedure TPointAssign(var P:TPoint; X,Y:integer);
  179. {=============================================================}
  180.  implementation
  181.  const
  182.    { Stream Registration Constants }
  183.    RList : TStreamRec = (
  184.      ObjType:200;
  185.      VmtLink: ofs(TypeOf(Tlist)^);
  186.      Load:@Tlist.load;
  187.      Store:@TList.Store);
  188.    RSortedList :TStreamRec = (
  189.      ObjType:201;
  190.      VmtLink:ofs(TypeOf(TSortedList)^);
  191.      Load:@TSortedList.load;
  192.      Store:@TSortedList.Store);
  193.  
  194.  
  195.    { TlistDialog INternal Commands }
  196.    const
  197.        tldAdd    = $2001;
  198.        tldEdit   = $2002;
  199.        tldDelete = $2003;
  200.        tldPicked = $2004;
  201.  
  202.    { Map for writestr under TDialog }
  203.        SearchPaletteMap = 28;
  204.   {==================================================================
  205.    Utilities
  206.    ==================================================================}
  207.   function Lput(source:string;width:word):string;
  208.     var
  209.       Temp:string[80];
  210.     begin
  211.       if length(source)>width then
  212.         Lput := copy(source,1,width)
  213.       else
  214.         begin
  215.         fillchar(Temp[1],width-length(source),32);
  216.         Temp[0] := char(width-length(source));
  217.         Lput := source + Temp;
  218.         end;
  219.       end;
  220.    {-----------------------------------}
  221.    Procedure TPointAssign(var P:TPoint; X,Y:integer);
  222.      begin
  223.      P.X := X;
  224.      P.Y := Y;
  225.      end;
  226.    {-----------------------------------}
  227.    procedure MakeTrect(Corner:Tpoint;Xsize,YSize:integer;var Bounds:Trect);
  228.      var
  229.        DX,DY:integer;
  230.        SH:byte;
  231.      begin
  232.      SH := ScreenHeight-2;
  233.      with Corner do
  234.        begin
  235.        DX := (X+XSize)-1;
  236.        DY := (Y+YSize)-1;
  237.        if DX>ScreenWidth then
  238.          if (XSize>ScreenWidth) then
  239.            begin
  240.            X := 0;
  241.            DX := ScreenWidth;
  242.            end
  243.          else
  244.            begin
  245.            X := X-(DX-ScreenWidth);
  246.            DX := (X+Xsize)-1;
  247.            end;
  248.        if DY>SH then
  249.          if (YSize>SH) then
  250.            begin
  251.            Y := 0;
  252.            DY := SH;
  253.            end
  254.          else
  255.            begin
  256.            Y := Y-(DY-SH);
  257.            DY := (Y+Ysize)-1;
  258.            end;
  259.       end;
  260.      Bounds.assign(Corner.X,Corner.Y,DX,DY);
  261.   end;
  262.   {==================================================================
  263.    TListBoxer  Class
  264.    ==================================================================}
  265.    procedure TListBoxer.HandleEvent(var Event:TEvent);
  266.      var
  267.        i:word;
  268.        Action : byte;
  269.      begin
  270.      Action := 0;
  271.      with Event do
  272.        begin
  273.        case What of
  274.          evKeyDown:
  275.            case keycode of
  276.              kbEnter:Action := 1;
  277.              kbIns:Action := 2;
  278.              kbdel:Action := 3;
  279.              kbCtrlEnter : Action := 4;
  280.              end;
  281.          evBroadCast:
  282.            case Command of
  283.              cmListItemSelected: Action := 1;
  284.              end;
  285.          end;
  286.        if Action >0 then
  287.          case Action of
  288.            1:
  289.              begin
  290.              What := evCommand;
  291.              Command := tldPicked;
  292.              end;
  293.            2:
  294.              begin
  295.              What := evCommand;
  296.              Command := tldAdd;
  297.              end;
  298.            3:
  299.              begin
  300.              What := evCommand;
  301.              Command := tldDelete;
  302.              end;
  303.            4:
  304.              begin
  305.              What := evCommand;
  306.              Command := tldEdit;
  307.              end;
  308.            end
  309.        else
  310.          TListbox.HandleEvent(Event);
  311.        end;
  312.      end;
  313.    {-----------------------------------}
  314.    function TListBoxer.GetText(Item:Integer; MaxLen:integer):string;
  315.        var
  316.          P:pointer;
  317.          T:string;
  318.      begin
  319.      P:= List^.At(Item);
  320.      T:= Plist(List)^.GetItemText(P,MaxLen);
  321.      GetText := T;
  322.      end;
  323.  
  324.   {==================================================================
  325.    TSortedListBoxer  Class
  326.    ==================================================================}
  327.    {-----------------------------------}
  328.    function TSortedListBoxer.GetText(Item:Integer; MaxLen:integer):string;
  329.        var
  330.          P:pointer;
  331.          T:string;
  332.      begin
  333.      P:= List^.At(Item);
  334.      T:= PSOrtedlist(List)^.GetItemText(P,MaxLen);
  335.      GetText := T;
  336.      end;
  337.    {-----------------------------------}
  338.  
  339.   {==================================================================
  340.    TList  abstract Class
  341.    ==================================================================}
  342.     function TList.CreateItem(Corner:TPoint):pointer;
  343.       begin CreateItem := nil end;
  344.     {------------------------------------}
  345.       procedure TList.editItem(Corner:TPoint;Item:pointer);
  346.       begin end;
  347.     {------------------------------------}
  348.     function TList.GetItemText(item:pointer;MaxLen:word):string;
  349.       begin
  350.       Abstract;
  351.       end;
  352.     {------------------------------------}
  353.     function TList.AtAddNewItem(Corner:TPoint;Index:integer):pointer;
  354.       var P:pointer;
  355.       begin
  356.       P := CreateItem(Corner);
  357.       if P<>nil then
  358.         AtInsert(Index,P);
  359.       AtAddNewItem := P;
  360.       end;
  361.     {------------------------------------}
  362.     function TList.MaxTextLength:word;
  363.       var
  364.         Tmax:word;
  365.       procedure GetMAx(P:pointer); far;
  366.         { Simply searches list and finds longest string }
  367.         var
  368.           I:word;
  369.           Temp:string;
  370.         begin
  371.         if P<>nil then
  372.           begin
  373.           Temp := GetItemText(P,$ff);
  374.           i:=length(Temp);
  375.           if i>TMax then TMax := i;
  376.           end;
  377.         end;
  378.  
  379.       begin
  380.         TMax := 0;
  381.         foreach(@GetMax);
  382.         MaxTextLength := Tmax;
  383.       end;
  384.   {==================================================================
  385.    TSortedList  abstract Class
  386.    ==================================================================}
  387.     function TSortedList.CreateItem(Corner:TPoint):pointer;
  388.       begin  CreateItem := nil end;
  389.     {------------------------------------}
  390.       procedure TSortedList.editItem(Corner:TPoint;Item:pointer);
  391.       begin end;
  392.     {------------------------------------}
  393.     function TSortedList.GetItemText(item:pointer;MaxLen:word):string;
  394.       begin
  395.       Abstract;
  396.       end;
  397.     {------------------------------------}
  398.     function TSortedList.AtAddNewItem(Corner:TPoint):pointer;
  399.       var P:pointer;
  400.       begin
  401.       P := CreateItem(Corner);
  402.       if P<>nil then
  403.         Insert(P);
  404.       AtAddNewItem := P;
  405.       end;
  406.     {------------------------------------}
  407.     function TSortedList.MaxTextLength:word;
  408.       var
  409.         Tmax:word;
  410.       procedure GetMAx(P:pointer); far;
  411.         { Simply searches list and finds longest string }
  412.         var
  413.           I:word;
  414.           Temp:string;
  415.         begin
  416.         if P<>nil then
  417.           begin
  418.           Temp := GetItemText(P,$ff);
  419.           i:=length(Temp);
  420.           if i>TMax then TMax := i;
  421.           end;
  422.         end;
  423.  
  424.       begin
  425.         TMax := 0;
  426.         foreach(@GetMax);
  427.         MaxTextLength := Tmax;
  428.       end;
  429.  
  430.   {==================================================================
  431.    TListDialog   Class
  432.    ==================================================================}
  433.      const
  434.        NoSortIndent = 5;
  435.        SortIndent = 18;
  436.        TopIndent = 11;
  437.      procedure   TListDialog.BASICinit(var Bounds:Trect; ATitle:TTitleStr;Behavior:byte;
  438.                            MaxStringLen:byte);
  439.        var
  440.          PV:PView;
  441.          i:integer;
  442.          R:Trect;
  443.        begin
  444.        { Minimum width for OK and Cancel is 10}
  445.         if MaxStringLen<10 then MaxStringLen:= 11;
  446.  
  447.        { Now if Buttons needed make sure Dialog is wide enough for
  448.          text and Buttons (add column width here later )}
  449.         if (sfFullEdit and Behavior)>0 then
  450.           i:=SortIndent else i:= NoSortIndent;
  451.         with Bounds do
  452.           if ((B.X - A.X)) < MaxStringLen+i then
  453.               B.X:=A.X+MaxStringLen+i;
  454.  
  455.        { Now Check if adequate height provided for list and
  456.          OK and Cancel Buttons, List can be minimum 4 items high. }
  457.         i := TopIndent;
  458.         if (sfSearch and Behavior)=0 then
  459.           dec(i);
  460.         with Bounds do
  461.           if (B.Y-A.Y)<i then B.Y := A.Y+i;
  462.        { Ok init Dialog }
  463.         TDialog.init(Bounds,ATitle);
  464.  
  465.        { Save Max }
  466.          Max := MaxStringLen;
  467.  
  468.        { Set Behavior }
  469.         AB := Behavior;
  470.        { Can not have search here }
  471.         AB := AB and $F7;
  472.        { Set Search String to nil }
  473.          SearchString := nil;
  474.        { Set Clear Record }
  475.         with TLR do
  476.          begin
  477.          Item:=nil;
  478.          Index:=-1;
  479.          end;
  480.  
  481.        { Ok Setup Search String Area if selected }
  482.         if (sfSearch and Behavior)>0 then
  483.           begin
  484.           X := 1;
  485.           Y := 1;
  486.           end
  487.         else
  488.          begin
  489.          X := 0;
  490.          Y := 0;
  491.          end;
  492.        { Setup Buttons }
  493.         if (sfFullEdit and AB)>0 then
  494.           begin
  495.           R.assign(Max+5,2,Max+13,4);
  496.           if (sfAdd and AB)>0 then
  497.             insert(new(PButton, init(R,' Add ',tldAdd,bfnormal)));
  498.           if (sfedit and AB)>0 then
  499.             begin
  500.             R.assign(Max+5,4,Max+14,6);
  501.             insert(new(PButton, init(R,' Edit ',tldedit,bfnormal)));
  502.             end;
  503.           if (sfdelete and AB)>0 then
  504.             begin
  505.             R.assign(Max+5,6,Max+16,8);
  506.             insert(new(PButton, init(R,' Delete ',tlddelete,bfnormal)));
  507.             end;
  508.           end;
  509.         { add OK and Cancel }
  510.           I := (Bounds.B.Y-Bounds.A.Y) - 3;
  511.           R.assign(1,i,6,I+2);
  512.           insert(new(PButton, init(R,'Ok',cmOk,bfnormal)));
  513.           R.assign(6,i,15,i+2);
  514.           insert(new(PButton, init(R,'Cancel',cmCancel,bfDefault)));
  515.  
  516.      end;
  517.     {------------------------------------------------------------------}
  518.  
  519.      constructor TListDialog.init
  520.                    (var Bounds:Trect; ATitle:TTitleStr;Behavior:byte;
  521.                     TheList : PList; BoxHeader:TTitleStr);
  522.       var
  523.         R:Trect;
  524.         SB:PSCrollBar;
  525.         i:word;
  526.         TMax:word;
  527.       {-------------------------------------}
  528.         begin
  529.        { Get Max Text Width of Tlist Items }
  530.         Tmax := TheList^.MaxTextLength;
  531.  
  532.         BASICinit(Bounds,ATitle,Behavior,TMax);
  533.  
  534.        { Save List }
  535.         List := TheList;
  536.  
  537.        { Ok now set up a scrollbar }
  538.         i:=(Bounds.B.Y-Bounds.A.Y)-4;
  539.         R.assign(Max+2,Y+2,Max+3,i);
  540.         SB := new(PScrollBar, init(R));
  541.         insert(SB);
  542.  
  543.        { Ok now setup ListBox }
  544.         R.assign(1,Y+2,Max+2,i);
  545.         LB := new(PlistBoxer, init(R,1,SB));
  546.        { Setup Initial Data to List Box, will be chnaged by
  547.          SetData later}
  548.         LB^.newlist(TheList);
  549.         LB^.FocusItem(0);
  550.         insert(LB);
  551.         { Add Box Header }
  552.         if BoxHeader <> '' then
  553.           begin
  554.           R.assign(1,Y+1,length(BoxHeader)+2,Y+2);
  555.           insert(new(Plabel,init(R,BoxHeader,LB)));
  556.           end;
  557.         end;
  558.     {-------------------------------------------------}
  559.      destructor TListDialog.done;
  560.        begin
  561.        TDialog.done;
  562.        if SearchString<>nil then
  563.           begin
  564.           freemem(SearchString,max);
  565.           end;
  566.        end;
  567.     {-------------------------------------------------}
  568.      function  TListDialog.DataSize: word;
  569.        begin
  570.        DataSize := sizeof(TLR);
  571.        end;
  572.     {-------------------------------------------------}
  573.      procedure TListDialog.GetData(var rec);
  574.        begin
  575.        move(TLR,rec,DataSize);
  576.        end;
  577.     {-------------------------------------------------}
  578.      procedure TListDialog.SetData(var rec);
  579.        begin
  580.        move(rec,TLR,dataSize);
  581.        if (TLR.index>0)and(TLR.INDEX<PLIST(List)^.count) then
  582.          LB^.focusItem(TLR.index);
  583.        end;
  584.     {-------------------------------------------------}
  585.      procedure TListDialog.HandleEvent(var Event:TEvent);
  586.      var
  587.        Affirmative : word;
  588.        FocusedIndex:integer;
  589.        FocusedItem:pointer;
  590.        NextEvent:TEvent;
  591.        MsgStr,ParamStr:Pstring;
  592.        R:TRect;
  593.       {--------------------------}
  594.       procedure UpdateLB(Index:integer);
  595.         begin
  596.         LB^.SetRange(PList(list)^.count);
  597.         LB^.focusItem(Index);
  598.         LB^.drawview;
  599.         end;
  600.       {--------------------------}
  601.  
  602.      begin
  603.       if (Event.What=evCommand) then
  604.         case Event.Command of
  605.          { OK It was selected we are ready to exit, Save data }
  606.          cmOk:
  607.            if LB^.range>0 then
  608.              with TLR do
  609.                begin
  610.                Index := LB^.Focused;
  611.                Item:=  PList(List)^.at(Index);
  612.                end
  613.            else
  614.              { If list is empty then return a -1 }
  615.              With TLR do
  616.                begin
  617.                Index := -1;
  618.                Item:=  nil;
  619.                end;
  620.          { Whoops, a cancel, make sure nil is loaded }
  621.          cmCancel,CmQuit:
  622.            with TLR do
  623.              begin
  624.              Index := EndOfCollection;
  625.              Item:=  nil;
  626.              end;
  627.          end;
  628.        TDialog.HandleEvent(Event);
  629.        if LB^.GetState(sfFocused) then
  630.              LB^.HandleEvent(Event);
  631.        FocusedIndex := LB^.Focused;
  632.        with Event do
  633.            case What of
  634.              evCommand:
  635.                case Command of
  636.               { Ok it was picked }
  637.                  tldpicked:
  638.                    begin
  639.                    with NextEvent do
  640.                      { If prompt then move to OK Button }
  641.                      if (AB and sfPromptExit)>0 then
  642.                        begin
  643.                        Selectnext(true);
  644.                        Selectnext(true);
  645.                        end
  646.                      else
  647.                        { Else Set CmOK }
  648.                        begin
  649.                        What := evCommand;
  650.                        command := cmOk;
  651.                        end;
  652.                    putevent(NextEvent);
  653.                    end;
  654.  
  655.               { Add Record }
  656.                  tldAdd:
  657.                    with PList(List)^ do
  658.                      begin
  659.                    { OK Add a new Item, check if nil afterward }
  660.                      R.Assign(1,1,0,0);
  661.                      MakeGlobal(R.A,R.A);
  662.                      FocusedItem := AtAddNewItem(R.A,FocusedIndex);
  663.                      if FocusedItem <> nil then
  664.                        begin
  665.                        FocusedIndeX := indexOf(FocusedItem);
  666.                        UpdateLB(FocusedIndex);
  667.                        end;
  668.                      end;
  669.  
  670.                { Edit Record }
  671.                  tldEdit:
  672.                    begin
  673.                    R.Assign(1,1,0,0);
  674.                    MakeGlobal(R.A,R.A);
  675.                    with PList(List)^ do
  676.                      EditItem(R.A,PList(List)^.at(LB^.Focused));
  677.                    LB^.drawview;
  678.                    end;
  679.  
  680.                { Delete Record }
  681.                  tldDelete:
  682.                    { Make sure something is there}
  683.                    if PList(list)^.count>0 then
  684.                      begin
  685.  
  686.                      { If prompt then prompt }
  687.                      if (AB and sfPromptDelete)>0 then
  688.                        begin
  689.                        with PList(List)^ do
  690.                          ParamStr := newstr(GetItemText(AT(FocusedIndex),Max));
  691.                          MsgStr := newStr('Delete: %s');
  692.                        Affirmative :=
  693.                          MessageBox(MsgSTr^,@ParamStr,
  694.                                     MFConfirmation+MfYesButton+MfNoButton);
  695.                        disposestr(Paramstr);
  696.                        disposestr(MsgStr);
  697.                        end
  698.                      else
  699.                        Affirmative := cmYes;
  700.  
  701.                      { If ok to delete then do so }
  702.                      if Affirmative= cmYes then
  703.                         begin
  704.  
  705.                         { Delete the focused item}
  706.                         PList(List)^.Delete(
  707.                            PList(List)^.AT(FocusedIndex));
  708.  
  709.                         { Now pack the list }
  710.                         PList(list)^.pack;
  711.  
  712.                         { Update LISTBOX  }
  713.                         if FocusedIndex>=PList(list)^.count then
  714.                             UpdateLB(FocusedIndex-1)
  715.                           else
  716.                             UpdateLB(focusedIndex);
  717.                         end;
  718.                    end;
  719.                end;
  720.            end;
  721.         end;
  722.   {==================================================================
  723.    TSortedListBoxDialog  Class
  724.    ==================================================================}
  725.      constructor TSortedListDialog.init
  726.                    (var Bounds:Trect; ATitle:TTitleStr;Behavior:byte;
  727.                     TheList : PSortedList; BoxHeader:TTitleStr);
  728.       var
  729.         R:Trect;
  730.         SB:PSCrollBar;
  731.         i:word;
  732.         TMax:word;
  733.         Fill:String[80];
  734.       {-------------------------------------}
  735.       procedure GetMAx(P:pointer); far;
  736.         var
  737.           I:word;
  738.           Temp:string;
  739.         begin
  740.         Temp := TheList^.GetItemText(P,$ff);
  741.         i:=length(Temp);
  742.         if i>TMax then TMax := i;
  743.         end;
  744.       {-------------------------------------}
  745.         begin
  746.        { Get Max Text Width of Tlist Items }
  747.         Tmax := 0;
  748.         Thelist^.foreach(@GetMax);
  749.  
  750.         BASICinit(Bounds,ATitle,Behavior,TMax);
  751.  
  752.        { Save List }
  753.         List := TheList;
  754.  
  755.        { Save Max String Legnth }
  756.         Max := TMax;
  757.  
  758.        { Ok now set up a scrollbar }
  759.         i:=(Bounds.B.Y-Bounds.A.Y)-4;
  760.         R.assign(Max+2,Y+2,Max+3,i);
  761.         SB := new(PScrollBar, init(R));
  762.         insert(SB);
  763.  
  764.        { Ok now setup ListBox }
  765.         R.assign(1,Y+2,Max+2,i);
  766.         LB := new(PSortedlistBoxer, init(R,1,SB));
  767.        { Setup Initial Data to List Box, will be chnaged by
  768.          SetData later}
  769.         LB^.newlist(TheList);
  770.         LB^.FocusItem(0);
  771.         insert(LB);
  772.         { Add Box Header }
  773.         if BoxHeader <> '' then
  774.           begin
  775.           R.assign(1,Y+1,length(BoxHeader)+2,Y+2);
  776.           insert(new(Plabel,init(R,BoxHeader,LB)));
  777.           end;
  778.  
  779.       { Create and Clear Search Field }
  780.         getmem(SearchString,max+1);
  781.         SearchString^ := '';
  782.       { Set behavior or search }
  783.         AB := AB or Behavior;
  784.       end;
  785.     {------------------------------------------------------------------}
  786.      procedure TSortedListDialog.HandleEvent(var Event:TEvent);
  787.      var
  788.        OldValue: Integer;
  789.        Affirmative : word;
  790.        FocusedIndex:integer;
  791.        FocusedItem:pointer;
  792.        NextEvent:TEvent;
  793.        MsgStr,ParamStr:Pstring;
  794.        R:Trect;
  795.        temp:string;
  796.       {--------------------------}
  797.        procedure KeySearch(KeyStr:PString);
  798.         var
  799.           i:integer;
  800.         begin
  801.         if (KeyStr<>nil) then
  802.           begin
  803.           PSortedList(List)^.search(KeyStr,i);
  804.           LB^.focusItem(i);
  805.           writestr(X,Y,Lput(KeyStr^,Max),SearchPaletteMap)
  806.           end
  807.        else
  808.           writestr(X,Y,Lput('',Max),SearchPaletteMap);
  809.        ClearEvent(Event);
  810.        end;
  811.       {--------------------------}
  812.       procedure UpdateLB(Index:integer);
  813.         begin
  814.         LB^.SetRange(PSortedList(list)^.count);
  815.         LB^.focusItem(Index);
  816.         LB^.drawview;
  817.         end;
  818.       {--------------------------}
  819.  
  820.      begin
  821.       if (Event.What=evCommand) then
  822.         case Event.Command of
  823.          { OK It was selected we are ready to exit, Save data }
  824.          cmOk:
  825.            begin
  826.            if LB^.range>0 then
  827.              with TLR do
  828.                begin
  829.                Index := LB^.Focused;
  830.                Item:=  PSortedList(List)^.at(Index);
  831.                end
  832.            else
  833.              { If list is empty then return a -1 }
  834.              With TLR do
  835.                begin
  836.                Index := -1;
  837.                Item:=  nil;
  838.                end
  839.  
  840.            end;
  841.          { Whoops, a cancel, make sure nil is loaded }
  842.          cmCancel,CmQuit:
  843.            with TLR do
  844.              begin
  845.              Index := EndOfCollection;
  846.              Item:=  nil;
  847.              end;
  848.          end;
  849.        OldValue := LB^.Focused;
  850.        if (Event.What<>evkeydown) or
  851.           ( (Event.What=evKeyDown)and
  852.             ((Event.CHarcode<#32)or(Event.CHarCode>#126) ) )then
  853.          TDialog.HandleEvent(Event)
  854.        else
  855.          if (LB^.GetState(sfFocused)) and
  856.         { Do not let List Box Use the SpaceBar to select }
  857.         (not ((Event.What=evKeyDown)and(Event.KeyCode=$3920))) then
  858.              LB^.HandleEvent(Event);
  859.        if (OldValue <> LB^.Focused) then
  860.          begin
  861.          if X>0 then
  862.            begin
  863.            {++}
  864.            if SearchString<> nil then
  865.              begin
  866.              SearchString^:='';
  867.              drawview;
  868.              end;
  869.            end;
  870.          end
  871.        else
  872.        begin
  873.        FocusedIndex := LB^.Focused;
  874.        with Event do
  875.            case What of
  876.              evKeyDown:
  877.               if (Event.CharCode <> #0)and(X>0)and(SearchSTring<>nil) then
  878.                 begin
  879.                 case KeyCode of
  880.                    kbback:
  881.                      begin
  882.                      if Length(SearchString^)>0 then
  883.                        begin
  884.                        dec(byte(searchstring^[0]));
  885.                        end
  886.                      end;
  887.                    else
  888.                      if SearchString^='' then
  889.                        SearchString^ := SearchString^+char(charcode)
  890.                      else
  891.                       if (length(SearchString^)<Max) and
  892.                        (CharCode > #31)and(CharCode<#128) and
  893.                          (ScanCode<>0) then
  894.                         begin
  895.                         SearchString^ := SearchString^+charcode;
  896.                         end;
  897.                   end;
  898.                 KeySearch(@SearchString^);
  899.                 end;
  900.              evCommand:
  901.                case Command of
  902.               { Ok it was picked }
  903.                  tldpicked:
  904.                    begin
  905.                    with NextEvent do
  906.                      { If prompt then move to OK Button }
  907.                      if (AB and sfPromptExit)>0 then
  908.                        begin
  909.                        Selectnext(true);
  910.                        Selectnext(true);
  911.                        end
  912.                      else
  913.                        { Else Set CmOK }
  914.                        begin
  915.                        What := evCommand;
  916.                        command := cmOk;
  917.                        end;
  918.                    putevent(NextEvent);
  919.                    end;
  920.  
  921.               { Add Record }
  922.                  tldAdd:
  923.                    with PSortedList(List)^ do
  924.                      begin
  925.  
  926.                    { OK Add a new Item, check if nil afterward }
  927.                      R.Assign(1,1,0,0);
  928.                      MakeGlobal(R.A,R.A);
  929.                      FocusedItem := AtAddNewItem(R.A);
  930.                      if FocusedItem <> nil then
  931.                        begin
  932.                        FocusedIndeX := indexOf(FocusedItem);
  933.                        UpdateLB(FocusedIndex);
  934.                        end;
  935.                      end;
  936.  
  937.                { Edit Record }
  938.                  tldEdit:
  939.                    begin
  940.                    R.Assign(1,1,0,0);
  941.                    MakeGlobal(R.A,R.A);
  942.                    FocusedItem := PSortedList(List)^.at(LB^.Focused);
  943.                    with PSortedList(List)^ do
  944.                      EditItem(R.A,FocusedItem);
  945.                    PSortedList(List)^.Delete(FocusedItem);
  946.                    PSortedList(List)^.insert(FocusedItem);
  947.                    PSortedList(list)^.pack;
  948.                    UpdateLB(PsortedList(list)^.indexof(focusedItem));
  949.                    end;
  950.  
  951.                { Delete Record }
  952.                  tldDelete:
  953.                    { Make sure something is there}
  954.                    if PsortedList(list)^.count>0 then
  955.                      begin
  956.  
  957.                      { If prompt then prompt }
  958.                      if (AB and sfPromptDelete)>0 then
  959.                        begin
  960.                        with PSortedList(List)^ do
  961.                          ParamStr := newstr(GetItemText(AT(FocusedIndex),Max));
  962.                          MsgStr := newStr('Delete: %s');
  963.                        Affirmative :=
  964.                          MessageBox(MsgSTr^,@ParamStr,
  965.                                     MFConfirmation+MfYesButton+MfNoButton);
  966.                        disposestr(Paramstr);
  967.                        disposestr(MsgStr);
  968.                        end
  969.                      else
  970.                        Affirmative := cmYes;
  971.  
  972.                      { If ok to delete then do so }
  973.                      if Affirmative= cmYes then
  974.                         begin
  975.  
  976.                         { Delete the focused item}
  977.                         PSortedList(List)^.Delete(
  978.                            PSortedList(List)^.AT(FocusedIndex));
  979.  
  980.                         { Now pack the list }
  981.                         PSortedList(list)^.pack;
  982.  
  983.                         { Update LISTBOX  }
  984.                         if FocusedIndex>=PsortedList(list)^.count then
  985.                             UpdateLB(FocusedIndex-1)
  986.                           else
  987.                             UpdateLB(focusedIndex);
  988.                         end;
  989.                    end;
  990.                end;
  991.            end;
  992.         end;
  993.      end;
  994.    {======================================================
  995.     TListDialogInputField
  996.     ======================================================}
  997.     constructor TListDialogInputField.init
  998.                      (Field:TPoint;ListLocation:Tpoint;ListHeight:word;
  999.                       Title:string;Behavior:byte;AList:Pointer;
  1000.                       BoxHeader:string;SortedList:boolean);
  1001.       var
  1002.         R:Trect;
  1003.         Tmax:byte;
  1004.         Corner:TPoint;
  1005.       begin
  1006.         {Finds Max Size }
  1007.         if SortedList then
  1008.           TMax := PSortedlist(Alist)^.MaxTextLength
  1009.         else
  1010.           TMax := Plist(Alist)^.MaxTextLength;
  1011.  
  1012.         { Locate and initialize field }
  1013.         R.assign(Field.X,Field.Y,Field.X+TMax+3,Field.Y+1);
  1014.         TInputLine.init(R,TMax+2);
  1015.  
  1016.         {initialize Slots }
  1017.         Sorted := SortedList;
  1018.         TL := Alist;
  1019.         Max := Tmax;
  1020.  
  1021.         { determine R based on bounds of owner of TInputLine }
  1022.         MakeGlobal(Field,Field);
  1023.         Field.X := Field.X + ListLocation.X;
  1024.         Field.Y := Field.Y + ListLocation.Y;
  1025.         MakeTrect(Field,Max+13,ListHeight-1,R);
  1026.  
  1027.        { Initialize ListDialog }
  1028.         if Sorted then
  1029.           begin
  1030.           TD := new(PSortedListDialog,Init(R,Title,Behavior,AList,BoxHeader));
  1031.           with PSortedList(Alist)^ do
  1032.             Data^ := GetItemText(AT(0),max);
  1033.           end
  1034.         else
  1035.           begin
  1036.           TD := new(PListDialog,Init(R,Title,Behavior,AList,BoxHeader));
  1037.           with PList(Alist)^ do
  1038.             Data^ := GetItemText(AT(0),max);
  1039.           end;
  1040.       end;
  1041.  
  1042.   {-----------------------------------------------------}
  1043.     destructor TListDialogInputField.done;
  1044.       begin
  1045.       TInputLine.done;
  1046.       if Sorted then
  1047.         dispose(PSortedListDialog(TD),done)
  1048.       else
  1049.         dispose(PListDialog(TD),done);
  1050.       end;
  1051.   {-----------------------------------------------------}
  1052.     procedure TListDialogInputField.HandleEvent(Var Event:TEvent);
  1053.    {------------------------}
  1054.       procedure OpenListDialog;
  1055.        var
  1056.          TCData : TlistRec;
  1057.          Result:word;
  1058.        begin
  1059.          TCData.index := index;
  1060.          if Sorted then
  1061.            begin
  1062.            TCData.item := PSortedList(TL)^.at(index);
  1063.            PSortedListDialog(TD)^.setdata(TCData);
  1064.            result := Desktop^.ExecView(PSortedListDialog(TD));
  1065.            end
  1066.          else
  1067.            begin
  1068.            TCData.item := PList(TL)^.at(index);
  1069.            PListDialog(TD)^.setdata(TCData);
  1070.            result := Desktop^.ExecView(PListDialog(TD));
  1071.            end;
  1072.          If Result = cmOk then
  1073.            begin
  1074.            if Sorted then
  1075.              begin
  1076.              PSortedListDialog(TD)^.Getdata(TCData);
  1077.              Data^ :=PSortedList(TL)^.getitemtext(TCData.item,max);
  1078.              end
  1079.            else
  1080.              begin
  1081.              PListDialog(TD)^.Getdata(TCData);
  1082.              Data^ :=PList(TL)^.getitemtext(TCData.item,max);
  1083.              end;
  1084.            Index :=  TCData.index;
  1085.            end
  1086.          else
  1087.            CLearEvent(Event);
  1088.        end;
  1089.     {======================================}
  1090.       begin
  1091.         with Event do
  1092.           case What of
  1093.             evMousedown:
  1094.                begin
  1095.                  if double and getstate(sffocused+sfselected) then
  1096.                    OpenListDialog
  1097.                end;
  1098.             evKeyDown:
  1099.               case KeyCode of
  1100.                 kbins,kbRight,kbLeft,kbCtrlF2:
  1101.                   begin
  1102.                   OpenListDialog;
  1103.                   end;
  1104.                 kbenter,kbdown:
  1105.                   begin
  1106.                   KeyCode := kbTab;
  1107.                   end;
  1108.                 kbup:
  1109.                   begin
  1110.                   KeyCode := kbShiftTab;
  1111.                   end;
  1112.                end;
  1113.              end;
  1114.         TInputLine.HandleEvent(Event);
  1115.       end;
  1116.   {-----------------------------------------------------}
  1117.     function  TListDialogInputField.DataSize:word;
  1118.       begin DataSize := 2; end;
  1119.    {------------------------------------------------------}
  1120.     procedure TListDialogInputField.GetData(Var Rec);
  1121.       var Value:word absolute rec;
  1122.       begin Value := index; end;
  1123.    {------------------------------------------------------}
  1124.     procedure TListDialogInputField.SetData(Var Rec);
  1125.       var
  1126.         Value:word absolute Rec;
  1127.       begin
  1128.         if (Value = EndOfCollection)or(Value >= PCOllection(TL)^.Count) then
  1129.           Index := PCollection(TL)^.count -1
  1130.         else
  1131.           Index := Value;
  1132.       if sorted then
  1133.         data^ := PSortedList(TL)^.getItemText(PList(TL)^.at(index),max)
  1134.       else
  1135.         data^ := PList(TL)^.getItemText(PSortedList(TL)^.at(index),max);
  1136.       end;
  1137.   {-------------------------------------------------}
  1138.   procedure RegisterTVList;
  1139.     begin
  1140.     RegisterType(RList);
  1141.     RegisterType(RSortedList);
  1142.     end;
  1143.   {-------------------------------------------------}
  1144.  
  1145.   {$Ifdef RegisterTVLIST}
  1146.    begin
  1147.    RegisterTVList;
  1148.   {$EndIf}
  1149. end.
  1150.  
  1151.